home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #22 (1994-01-19)(Diesel)(DE)[WB].zip / Purity #22 (1994-01-19)(Diesel)(DE)[WB].adf / IntuiWindow / IntuitionWindow.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-17  |  7KB  |  162 lines
  1. {*******************************************************************}
  2. { IntuitionDemo.PAS                                                 }
  3. {                                                                   }
  4. { Clear code for showing you the use of Intuition and Graphics on   }
  5. { the Amiga...                                                      }
  6. {*******************************************************************}
  7. { By Hans Luyten September 1993                                     }
  8. { Compiler: HighSpeed Pascal 1.1                                    }
  9. {*******************************************************************}
  10. PROGRAM Intuitiondemo;
  11.  
  12. uses
  13.   Exec, Intuition, Graphics;          { We need these....           }
  14.  
  15. VAR
  16.   MyWindow  :  tNewWindow;            { Struct for the NewWindow    }
  17.   Window    : pWindow;                { Pointer to the NewWindow    }
  18.   MyRastPort:  pRastPort;             { Pointer to Window RastPort  }
  19.   
  20.   Teller    : INTEGER;
  21.   c          : CHAR;
  22.                   
  23.   TempString: ARRAY [1..80] OF byte;  { Temp C-stringkind           }
  24.     
  25. {*******************************************************************}
  26. { OpenIntuitionLib(version);                                        }
  27. {                                                                   }
  28. { Tries to open the Intuition.library, if version=0 then ANY        }
  29. { version of intuition.library will be opened.                      }
  30. { It will return TRUE or FALSE.                                     }
  31. {*******************************************************************}  
  32. FUNCTION OpenIntuitionLib(version:INTEGER):BOOLEAN;
  33. BEGIN
  34.   IntuitionBase:=pIntuitionBase(OpenLibrary('intuition.library',version));
  35.   IF IntuitionBase=NIL THEN
  36.     OpenIntuitionLib:=FALSE
  37.   ELSE
  38.     OpenIntuitionLib:=TRUE;
  39. END;
  40.  
  41. {*******************************************************************}
  42. { OpenGraphicsLib(version);                                         }
  43. {                                                                   }
  44. { Tries to open the Graphics.library, if version=0 then ANY         }
  45. { version of Graphics.library will be opened.                       }
  46. { It will return TRUE or FALSE.                                     }
  47. {*******************************************************************}  
  48. FUNCTION OpenGraphicsLib(version:INTEGER):BOOLEAN;
  49. BEGIN
  50.   GfxBase:=pGfxBase(OpenLibrary('graphics.library',version));
  51.   IF GfxBase=NIL THEN
  52.     OpenGraphicsLib:=FALSE
  53.   ELSE
  54.     OpenGraphicsLib:=TRUE;
  55. END;
  56.  
  57. {*******************************************************************}
  58. { GfxText(RPort,x,y,color,'Text');                                  }
  59. {                                                                   }
  60. { Display the text on the rastport... using color and x,y           }
  61. { OutTextXY() look-a-like using intuition/graphics                  }
  62. {*******************************************************************}
  63. PROCEDURE GfxText(RPort : pRastPort; x,y : INTEGER; 
  64.                   color : INTEGER; TempText : String);
  65. VAR
  66.   TempString  :  ARRAY [1..80] OF byte;
  67. BEGIN
  68.   SetAPen(RPort,Color);                       { Set Pen Color       }
  69.   Move_(RPort,x,y);                           { Move pen            }
  70.   PasToC(TempText,TempString);                { Convert to C-String }
  71.   Text_(RPort,@TempString,length(TempText));  { Write string !!     }
  72. END;
  73.  
  74. {*******************************************************************}  
  75. { OpenNewWindow(....);                                              }
  76. {                                                                   }
  77. { Tries to open a NewWindow, ALL parameters for the NewWindowStruct }
  78. { are passed to OpenNewWindow !                                     }
  79. { It will return the pWindow pointer.                               }
  80. { TitleMode is TRUE if you USE a title, and FALSE if you don't !!   }
  81. {*******************************************************************}  
  82. FUNCTION OpenNewWindow(WLeftEdge,WTopEdge,WWidth,WHeight: INTEGER;
  83.                        WDetailPen,WBlockPen: shortint;
  84.                        WIDCMPFlags,WFlags: long;
  85.                        WFirstGadget: pGadget;
  86.                        WCheckMark: pImage;
  87.                        WTitle: string;
  88.                        WScreen: pScreen;
  89.                        WBitMap: pBitMap;
  90.                        WMinWidth,WMinHeight: INTEGER;
  91.                        WMaxWidth,WMaxHeight,WType_: word;
  92.                        TitleMode:BOOLEAN):pWindow;
  93. VAR TempWindow  :  tNewWindow;
  94.     TempTitle   :  ARRAY [1..80] OF byte;
  95. BEGIN
  96.   IF TitleMode THEN                { Title to C-format string       }
  97.     PasToC(WTitle,TempTitle);
  98.   WITH TempWindow DO
  99.     BEGIN
  100.       LeftEdge    :=WLeftEdge;
  101.       TopEdge     :=WTopEdge;
  102.       Width       :=WWidth;
  103.       Height      :=WHeight;
  104.       DetailPen   :=WDetailPen;
  105.       BlockPen    :=WBlockPen;
  106.       IDCMPFlags  :=WIDCMPFlags;
  107.       Flags       :=WFlags;
  108.       FirstGadget :=WFirstGadget;
  109.       CheckMark   :=WCheckMark;
  110.       Title       :=@TempTitle;    { POINTER to the title string    }
  111.       Screen      :=WScreen;
  112.       BitMap      :=WBitMap;
  113.       MinWidth    :=WMinwidth;
  114.       MinHeight   :=WMinHeight;
  115.       MaxWidth    :=WMaxWidth;
  116.       MaxHeight   :=WMaxHeight;
  117.       Type_       :=WType_;
  118.     END;
  119.     IF NOT(TitleMode) THEN
  120.       TempWindow.Title:=NIL;
  121.     OpenNewWindow := OpenWindow(@TempWindow);  
  122. END;
  123.  
  124. {*******************************************************************}  
  125. { Main                                                              }
  126. {*******************************************************************}  
  127. BEGIN
  128.   IF ((OpenIntuitionLib(39))AND(OpenGraphicsLib(39))) THEN
  129.   BEGIN
  130.     Window:=OpenNewWindow(10,10,600,200,2,3,ACTIVEWINDOW,
  131.                           SMART_REFRESH OR NOCAREREFRESH,
  132.                           NIL,NIL,
  133.                           'My First HighSpeed Pascal Window',
  134.                           NIL,NIL,10,10,640,256,
  135.                           WBENCHSCREEN,TRUE);
  136.             
  137.     IF Window<>NIL THEN
  138.       BEGIN  
  139.         MyRastPort:=Window^.RPort;            { The window-Rastport }
  140.         
  141.         FOR Teller:=1 TO 150 DO
  142.           BEGIN
  143.             SetAPen(MyRastPort,Random(8));    
  144.             DrawCircle(MyRastPort,Random(500)+50,Random(100)+50,Random(30));
  145.           END;
  146.         Move_(MyRastPort,300,40);             { Draw circles...     }
  147.         
  148.         GfxText(MyRastPort,300,40,1,'A Small demo in HSPascal ');
  149.                 
  150.         SetAPen(MyRastPort,2);
  151.         Move_(MyRastPort,300,42);             { Move pen            }
  152.         Draw(MyRastPort,490,42);              { Underline text      }
  153.         
  154.         GfxText(MyRastPort,300,190,3,'I will exit after 3000 MilliSecs...');
  155.         
  156.         Delay(3000);                    
  157.         CloseWindow(Window);                  { Close the window    }
  158.       END;
  159.     CloseLibrary(pLibrary(IntuitionBase));    { Close LIBS !!       }
  160.     CloseLibrary(pLibrary(GfxBase));
  161.   END;
  162. END.